#
# Copyright (c) 2013-2014 Luciano Xumerle. All rights reserved.
#
# This file is part of gephinfo.
#
# gephinfo is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

package myUTL;

require 5.003;
use warnings;
use strict;
use utf8;

=head1 NAME

myUTL

=head1 STRING UTILITIES

Functions to manage string. 

=over 3

=cut

=back

=head2 getNumberSTDIN([$min],[$max])

Load number from <STDIN>.

=cut

sub getNumberSTDIN
{
    my $min   = shift;
    my $max   = shift;
    my $input = '';
    while ( $input =~ m/^\s*$/ )
    {
        $input = <STDIN>;
        chomp $input;
        if ( $input =~ m/^\d+$/ )
        {
            $input = ''
              if ( defined $min
                && $min =~ m/^\d+$/
                && defined $max
                && $max =~ m/^\d+$/
                && $min < $max
                && ( $input > $max || $input < $min ) );
        }
        else { $input = ''; }
    }
    return $input;
}

=head2 getStringSTDIN()

Load string from <STDIN>.

=cut

sub getStringSTDIN
{
    my $input = undef;
    while ( !defined $input )
    {
        &myUTL::printerr("\n --> ");
        $input = <STDIN>;
        chomp $input;
        $input = '' if ( $input !~ m/^\s*^/ );
    }
    return $input;
}

=head2 isOK()

return 1 if previous input is "Y".
else return 0.

=cut

sub isOK
{
    &myUTL::printerr(' (Y/n): ');
    my $tt = <STDIN>;
    if   ( $tt =~ m/^[y\s]*$/i ) { return 1; }
    else                         { return 0; }
}

=head2 printerr($string)

print to STDERR

=cut

sub printerr { print STDERR (shift); }

=head2 writeFile($file, $contents)

Writes $contents to $file.
It works also with "perl -t".

=cut

sub writeFile
{
    my $file = shift;
    my $cont = shift;
    open( FILE, "> $file" ) || die "ERROR: File is not writeable.\n";
    syswrite FILE, $cont;
    close FILE;
}

=head2 getRandString($length [, $onlyLowercase])

Returns a random string with alphanumeric characters.

=cut

sub getRandString
{
    my $strLength = shift;
    my $lowerCase = shift;
    my @food      = ( 'a' .. 'z', 0 .. 9 );
    push @food, ( 'A' .. 'Z' )
      if ( !( defined $lowerCase && $lowerCase eq 1 ) );
    my $retVal = '';
    while ( $strLength-- ) { $retVal .= $food[ rand(@food) ]; }
    return $retVal;
}

=head2 toCapitalize($string)

Capitalize words in string.

  es.
  
    'bye bye' => 'Bye Bye'

=cut

sub toCapitalize
{
    my $tt = lc(shift);
    $tt =~ s/(?<![[:alpha:]])([[:alpha:]])/uc($1)/ge;
    return $tt;
}

=head2 trim($string)

Trim spaces.

  es.
      '  hello     bye   ' =>  'hello bye'

=cut

sub trim
{
    my $db = shift;
    return '' if ( !defined $db );
    $db =~ s/^\s+//;
    $db =~ s/\s+$//;
    $db =~ s/\s+/ /g;
    return $db;
}

=head2 uri2ascii($string)

Converts the URI string to the ASCII string.

=cut

sub uri2ascii
{
    my $tt = shift;
    while ( $tt =~ m/(%[0-f]{2})/i )
    {
        my $r = $1;
        my $t = $r;
        $r =~ s/^%//;
        $r = chr( hex($r) );
        $tt =~ s/$t/$r/;
    }
    return $tt;
}

=head2 doReplace($string, \@conversionArray)

Replaces substrings using a list [ ["substring to be replaced", "new substring"] ]

=cut

sub doReplace
{
    my $tt    = shift;
    my $array = shift;
    foreach my $pp ( @{$array} )
    {
        $tt =~ s/$pp->[0]/$pp->[1]/g;
    }
    return $tt;
}

=head2 setNewLine($string)

Relaces newline char to '-+-'

=cut

sub setNewLine
{
    my $db = shift;
    $db = '' if ( $db =~ m/^\s*$/ );
    $db =~ s/\s*[\r\n]+\s*/-+-/g;
    return $db;
}

=head2 unsetNewLine($string)

Replaces -+-' to "\n".

=cut

sub unsetNewLine
{
    my $db = shift;
    $db = '' if ( $db =~ m/^\s*$/ );
    $db =~ s/\-\+\-/\n/g;
    return $db;
}

=head2 getDate

 Function  : Generate a text representation of the current date/time
 Arguments : String
 Returns   : Scalar text string
 Example   : print LOG now('fancy')
 Scope     : Public
 Comments  : Formats: raw       : comma-delimited output from localtime(time)
                      simple    : "1965-11-14 12:45:44"
                      dayonly   : "14 November 1965"
                      fancy     : "Friday November 14, 1965 12:45:44"
                      sql       : "1965-11-14"
                      psql      : "10-21-2003"

=cut

sub getDate
{
    my $format = shift || "raw";

    my @textDays = qw(Sunday Monday Tuesday Wednesday
      Thursday Friday Saturday);
    my @textMonths = qw(January February March April MAy June July
      August September October November December);
    my ( $textDay, $textMonth, $now );

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
      localtime(time);

    $year += 1900 unless $format eq "raw";

    if ( $format eq "sql" )
    {
        $mon++;
        ( $mon < 10 )  and ( $mon  = "0" . $mon );
        ( $mday < 10 ) and ( $mday = "0" . $mday );
        $now = "$year-$mon-$mday";
    }
    elsif ( $format eq "psql" )
    {
        $mon++;
        ( $mon < 10 )  and ( $mon  = "0" . $mon );
        ( $mday < 10 ) and ( $mday = "0" . $mday );
        $now = "$mon-$mday-$year";
    }
    elsif ( $format eq "simple" )
    {
        $mon++;
        ( $mon < 10 )  and ( $mon  = "0" . $mon );
        ( $mday < 10 ) and ( $mday = "0" . $mday );
        $now = "$year-$mon-$mday $hour:$min:$sec";
    }
    elsif ( $format eq "fancy" )
    {
        $textDay   = $textDays[$wday];
        $textMonth = $textMonths[$mon];
        $now       = "$textDay $textMonth $mday, $year $hour:$min:$sec";
    }
    elsif ( $format eq "dayonly" )
    {
        $textMonth = $textMonths[$mon];
        $now       = "$mday $textMonth $year";
    }
    else
    {    # raw format
        $now = "$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst";
    }
    return $now;
}

=head2 <printInfo($0, $author, $version, $data, $authEmail)

Print to STDERR program name, author & release date.

=cut

sub printInfo
{
    my $pth     = shift;
    my $author  = shift;
    my $version = shift;
    my $data    = shift;
    my $email   = shift;
    my $years   = shift;
    $years = '' if ( !defined $years );

    $pth =~ s/^.*\///;
    print STDERR
qq|---------------------------------------------------------------------------
$pth version $version ($data)
Copyright $years by $author <$email>
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
[-h] : Print help.
---------------------------------------------------------------------------
|;
}

=head2 isInArray($array, $element)

Returns "1" if $elements matchs in $array.

=cut

sub isInArray
{
    my ( $array, $id ) = @_;
    foreach (@$array) { return 1 if ( $id eq $_ ); }
    return 0;
}

=head2 rm_accentate($string)

Replaces characters with accent with a' e' i' o' u' and so on

=cut

sub rm_accentate
{
    my $xnew = shift;
    $xnew =~ s/[Èèé]/e'/g;    ## Converts È, è,  é to e'
    $xnew =~ s/[Òò]/o'/g;      ## Converts Ò, ò  to o'
    $xnew =~ s/[Ìì]/i'/g;      ## Converts Ì, ì to i'
    $xnew =~ s/[Ùù]/u'/g;      ## Converts Ù, ù to u'
    $xnew =~ s/[Àà]/a'/g;      ## Converts À, à to a'
    return $xnew;
}

=head2 getIDorder(\@array)

Sorts a list of values like Bb01.100

=cut

sub getIDorder
{
    my $tt   = shift;            ## ELEMENT ARRAY
    my @data = ();

    ## PROCESS ELEMENT LIST
    foreach ( @{$tt} )
    {
        push @data, &myUTL::getSortElement($_);
    }

    ## REORDER ARRAY
    @data = sort {
             compare( $a->[0], $b->[0] )
          || compare( $a->[1], $b->[1] )
          || compare( $a->[2], $b->[2] );
    } @data;

    ## prepare array
    foreach (@data) { $_ = join '', @{$_}; }

    ## return results
    return \@data;
}

## USED by getIDorder
sub getSortElement
{
    my $row = shift;

    if ( $row =~ m/^(\-{0,1}\d+\.{0,1}\d*)$/ )
    {    ## numero-(.numero)
        return [ '', $1, '' ];
    }
    elsif ( $row =~ m/^([a-zA-Z\.]+)$/ )
    {    ## word
        return [ $1, '', '' ];
    }
    elsif ( $row =~ m/^(\-{0,1}\d+\.{0,1}\d*)(\w+)$/ )
    {    ## numero-(.numero)-word
        return [ '', $1, $2 ];
    }
    elsif ( $row =~ m/^([a-zA-Z\.]+)(\-{0,1}\d+\.{0,1}\d*)$/ )
    {    ## word-numero-(.numero)
        return [ $1, $2, '' ];
    }
    elsif ( $row =~ m/^([a-zA-Z\.]+)(\-{0,1}\d+\.{0,1}\d*)([a-zA-Z]+)$/ )
    {    ## word-numero-(.numero)-word
        return [ $1, $2, $3 ];
    }
    elsif ( $row =~ m/^(.*);(.*)$/ )
    {    ## genotipo
        my $t = &myUTL::getIDorder( [ $1, $2 ] );
        return [ $t->[0], ';', $t->[1] ];
    }
    elsif ( $row =~ m/^(.*\w+.*)$/ )
    {    ## word + strange chars
        return [ $1, '', '' ];
    }
    else
    {
        return [ '', '', '' ];
    }
}

=head2 compare($a, $b)

Sorts automagically a pair of numbers/strings.

Example:

      @data = sort { &compare( $a->[0], $b->[0] ) } @data;

=cut

sub compare
{
    my ( $a, $b ) = @_;
    ( $a =~ /^\-{0,1}\d+\.{0,1}\d*$/ && $b =~ /^\-{0,1}\d+\.{0,1}\d*$/ )
      ? $a <=> $b
      : $a cmp $b;
}

=head2 getMD5($string)

Retrive MD5sum from a string.

=cut

sub getMD5
{
    use Digest::MD5;
    my $tt = shift;
    return &Digest::MD5::md5_hex($tt);
}

=head2 getFileList($results, $path, $match, $recursive, $noPath)

Get file list from a directory.

  $result:	in an array pointer
  $path:	start directory
  $match:	files mask
  $recursive:	work recursive 1=yes, 0=no
  $noPath:      return only the filename if ($noPath == 1)

=cut

sub getFileList
{
    my $result    = shift;
    my $path      = shift;
    my $match     = shift;
    my $recursive = shift;
    my $noPath    = shift;
    $noPath = 0 if ( !( defined $noPath && $noPath == 1 ) );
    my @filelist;

    opendir( DIR, $path ) || die "Can't open Directory '$path'\n";
    @filelist = readdir(DIR);
    closedir DIR;

    foreach ( sort @filelist )
    {
        my $file = ( $path . '/' . $_ );
        if ( m/^\.(?=\w)/ || m/^\.+$/ ) { next; }
        if ( m/$match/ && -e $file )
        {
            $file = $_ if ($noPath);
            push @{$result}, $file;
        }
        if ( defined $recursive && $recursive eq 1 && -d $file )
        {
            &myUTL::getFileList( $result, $file, $match, $recursive );
        }
    }
}

=head2 B<read_dir($dir, $string)>

Returns the pointer to the list of files in $dir matching  $string.

Example:

      @list = @{ read_dir('/tmp', 'class') };

=cut

sub read_dir
{
    my $path = shift;
    my $ext  = shift;
    $path =~ s/\/$//;
    my @lista;
    opendir( DIR, $path ) || die "Can't open Directory";
    @lista = grep { /$ext/ } readdir(DIR);
    closedir DIR;
    @lista = sort @lista;
    return \@lista;
}

=head2 unix2dos($file)

Replaces UNIX newline to DOS newline.

=cut

sub unix2dos
{
    my $f       = shift;
    my $inverse = shift;
    if ( -f $f )
    {
        $inverse = 0 if ( !defined $inverse || $inverse ne 1 );
        my $file = '';
        open( FILE, $f ) || die;
        while (<FILE>)
        {
            chomp;
            if ($inverse)
            {
                s/[\s\n\r]*$/\n/;
            }
            else { s/[\s\n\r]*$/\r\n/; }
            $file .= $_;
        }
        close FILE;
        &myUTL::writeFile( $f, $file );
    }
}

=head2 dos2unix($file)

Replaces DOS newline to UNIX newline.

=cut

sub dos2unix { &myUTL::unix2dos( (shift), 1 ); }

=head2 getFMT($list [, $width] )

Make the fmt command on a list (array).
Default line width is 72 chars.

=cut

sub getFMT
{
    my $list  = shift;
    my $width = shift;
    $width = 72 if ( !defined $width || $width !~ m/^\d+$/ );
    my $len = 0;
    my $word;
    my $out = '';
    foreach my $line ( @{$list} )
    {

        foreach my $word ( split( /\s+/, $line ) )
        {
            if ( $width < ( $len + length($word) + 1 ) )
            {
                $out =~ s/\s+$/\n/;
                $len = 0;
            }
            $out .= qq|$word |;
            $len += length($word) + 1;
        }
    }
    return $out;
}

=head2 transposeTable( \@table )

Transpose a 2x2 array.

=cut

sub transposeTable
{
    my $table = shift;
    my @newTable;
    my $col = 0;
    foreach my $rr ( @{$table} )
    {
        my $row = 0;
        foreach ( @{$rr} )
        {
            $newTable[$row][$col] = $_;
            $row++;
        }
        $col++;
    }
    return \@newTable;
}

=head2 setRomanNumberCase($string)

Roman number is set upper case.

=cut

sub setRomanNumberCase
{
    my $tt = shift;
    $tt = uc($tt) if ( $tt =~ m/^[IVXLCDM]+$/i );
    return $tt;
}

=head2 getAcronym($string)

Returns acronim in correct case.

=cut

sub getAcronym
{
    my $tt = shift;

    $tt =~ s/^ost$/OST/i;        # OST
    $tt =~ s/^xfree$/XFree/i;    # XFree
    $tt =~ s/^cddb$/CDDB/i;      # CDDB
    $tt =~ s/^id$/ID/i;          # CD
    $tt =~ s/^dj$/DJ/i;          # DJ
    $tt =~ s/^usa$/USA/i;        # USA
    $tt =~ s/^us$/US/i;          # US
    $tt =~ s/^uk$/UK/i;          # UK

    $tt =~ s/^dvd(?=\d+)/DVD/i;  # DVD
    $tt =~ s/^cd(?=\d+)/CD/i;    # CD
    $tt =~ s/^cds(?=\d+)/CDs/i;  # CDs
    $tt =~ s/^ep(?=\d+)/EP/i;    # EP
    $tt =~ s/^lp(?=\d+)/LP/i;    # LP
    $tt =~ s/^cdr(?=\d+)/CDR/i;  # CDR
    $tt =~ s/^ms/MS/i;           # MS
    return $tt;
}

=head2 importCDDBfile($file)

Load freedb/cddb file into an hash.

=cut

sub importCDDBfile
{
    my $file = shift;
    my $res  = {
        'artist' => undef,
        'songs'  => [],
        'year'   => undef,
        'album'  => undef,
        'DIR'    => undef
    };

    # OPEN TEXT FILE
    open( FILE, "< $file" ) || return $res;
    while (<FILE>)
    {
        if ( !defined $res->{'album'} )
        {
            next if m/^\s*$/;
            s/\)\s*$//;

            my @title = ();
            if (m/\s+::\s+/)
            {
                @title = split /\s+::\s+/, $_;
            }
            else
            {
                @title = split /\/+/, $_;
            }
            $res->{'artist'} = &myUTL::trim( shift(@title) );
            $title[0] = join '/', @title;
            @title = split /\(+/, $title[0];
            $res->{'year'} = pop @title
              if ( defined $title[$#title] && $title[$#title] =~ m/^\d{4}$/ );
            $res->{'album'} = &myUTL::trim( join '(', @title );
            $res->{DIR} = $res->{artist} . ' - ' . $res->{album};
            $res->{DIR} =~ s/\//&/g;

            if ( defined $res->{'year'} )
            {
                $res->{DIR} .= ' (' . $res->{year} . ')';
            }
        }
        else
        {
            next if ( !m/^\s*\d+\.\s*.+$/ );
            chomp;
            s/^\s*\d+\.//;              ## CDDB & FREEDB NUMBER
            s/^\s*\d+:\d+\s+(?=.)//;    ## FREEDB TRACK TIME
            s/[\n\r\s\-_*.:;,#]+$//;
            my $ar   = $res->{'artist'};
            my $song = &myUTL::trim($_);
            if (m/\s+::\s+/)
            {
                ( $ar, $song ) = split /\s+::\s+/, $song;
            }
            push( @{ $res->{'songs'} }, [ $ar, $song ] );
        }
    }
    close FILE;
    return $res;
}

=head1 AUTHOR

Luciano Xumerle (luciano.xumerle@gmail.com)
